home *** CD-ROM | disk | FTP | other *** search
/ Business Shareware / Business Shareware.iso / start / wordproc / me_cd25 / calc.mut < prev    next >
Encoding:
Text File  |  1992-11-09  |  3.4 KB  |  131 lines
  1.   ;; calc.mut : a popup programmers calculator for ME
  2.   ;; C Durland    Public Domain
  3.  
  4.   ;; Requires:
  5.   ;;   popup.mut
  6.  
  7. (include me2.h)
  8. (include tobase.mut)
  9.  
  10. (int RV TV mem)
  11. (small-int base)
  12.  
  13. (defun
  14.   doc HIDDEN    ; popup a window with documentation
  15.   {
  16.     (menu-box
  17.     ">Mutt CALC - an RPN calculator"
  18.     "+ - * (or x) /"
  19.     "Enter or Return : move x to total"
  20.     "m : Negate x"
  21.     "| & \^ : bitwise OR, AND, XOR total and x"
  22.     "< > : shift left or right"
  23.     "% : total mod x"
  24.     "s : Store total in memory"
  25.     "r : Recall memory to x"
  26.     "= : Insert total at dot"
  27.     "\^H or BACKSPACE : Erase last digit of x"
  28.     "\^L : Redraw the screen"
  29.     "# : Toggle between decimal and hex"
  30.     "B : Change the radix"
  31.     "k : Put the next key pressed into total"
  32.     'q ^G : Quit')
  33.     (refresh-screen)
  34.   }
  35.   MAIN
  36.   {
  37.     (base 10)                ;; initialize base to decimal
  38.     (require "menu-box" "popup.mut")    ;; for (doc)
  39.   }
  40.   inc (int n) HIDDEN        ; increment TV by n
  41.   {
  42.     (if (< n base) (TV (+ (* TV base) n)) )
  43.   }
  44.   vert (int n)    HIDDEN    ; convert n to proper base for display
  45.   {
  46.     (if (== base 10) { n (done) } )
  47.     (if (< n 0) (concat "-" (tobase (- 0 n) base)) (tobase n base))
  48.   }
  49. ;  odd (int n) HIDDEN { (!= n (* (/ n 2) 2)) }    ; TRUE if n is odd
  50. ;  bitwise (pointer defun op)(int x y) HIDDEN    ; (bitwise-op x y)
  51. ;  {
  52. ;    (int bit result a b)
  53. ;
  54. ;    (result 0)(bit 1)(a x)(b y)
  55. ;    (while (or (!= 0 a)(!= 0 b))
  56. ;    {
  57. ;      (if (op a b) (+= result bit))
  58. ;      (*= bit 2)    ; next bit
  59. ;      (/= a 2)(/= b 2)
  60. ;    })
  61. ;    result
  62. ;  }
  63. ;  bor  (int a b) HIDDEN { (or (odd a)(odd b)) }  ;TRUE if ((a&1) OR (b&1))==1
  64. ;  band (int a b) HIDDEN { (and (odd a)(odd b)) } ;TRUE if ((a&1) AND (b&1))==1
  65. ;  bxor (int a b) HIDDEN { (odd (+ a b)) }     ;TRUE if ((a&1) XOR (b&1))==1
  66. ;  bit-or  (int x y) HIDDEN { (bitwise (floc bor)  x y) }
  67. ;  bit-and (int x y) HIDDEN { (bitwise (floc band) x y) }
  68. ;  bit-xor (int x y) HIDDEN { (bitwise (floc bxor) x y) }
  69.   calculator
  70.   {
  71.     (int n)
  72.  
  73.     (while TRUE
  74.     {
  75.       (msg "RPN CALC>" base " Memory: " (vert mem base)
  76.     " Total: " (vert RV) "  x: " (vert TV) )
  77.       (switch (getchar)
  78.     "0" (inc 0)
  79.     "1" (inc 1)
  80.     "2" (inc 2)
  81.     "3" (inc 3)
  82.     "4" (inc 4)
  83.     "5" (inc 5)
  84.     "6" (inc 6)
  85.     "7" (inc 7)
  86.     "8" (inc 8)
  87.     "9" (inc 9)
  88.         "+" { (+= RV TV)(TV 0) }
  89.         "-" { (-= RV TV)(TV 0) }
  90.         "*" { (*= RV TV)(TV 0) }
  91.         "x" { (*= RV TV)(TV 0) }
  92.         "/" { (if (== 0 TV)(RV 0)(/= RV TV)) (TV 0) } 
  93.     "a" (inc 10)
  94.     "b" (inc 11)
  95.     "c" (inc 12)
  96.     "d" (inc 13)
  97.     "e" (inc 14)
  98.     "f" (inc 15)
  99.     "=" { (insert-text (vert RV))(update) }
  100.     "^M" { (RV TV)(TV 0) }            ; enter
  101.     "m" (*= TV -1)                ; change sign
  102.     "|" { (RV (bit-or RV TV)) (TV 0) }
  103.     "&" { (RV (bit-and RV TV)) (TV 0) }
  104.     '^' { (RV (bit-xor RV TV)) (TV 0) }
  105.     '%' { (if (== 0 TV)(RV 0)(RV (mod RV TV))) (TV 0) }
  106.     "^H" (/= TV base)
  107.     "s" (mem RV)                ; store
  108.     "r" (TV mem)                ; recall
  109.     "^L" { (refresh-screen)(update) }    ; refresh screen
  110.     ">" (/= RV 2)                ; shift right
  111.     "<" (*= RV 2)                ; shift left
  112.     "#" (if (== base 10)(base 16)(base 10))    ; toggle radix
  113.     "B"                    ; change radix
  114.       {
  115.         (n (convert-to NUMBER (ask "base = ")))
  116.         (if (and (<= 2 n)(<= n 16)) (base n))
  117.       }
  118.     "k"
  119.       {
  120.         (msg "Press key to convert")
  121.         (RV (convert-to CHARACTER (getchar)))
  122.       }
  123.     "K" { (msg "Press ME key to convert")(RV (get-key)) }
  124.     "?" (doc)
  125.     "q" (break)            ; quit
  126.     "^G" (break)            ; quit
  127.       )
  128.     })
  129.   }
  130. )
  131.